home *** CD-ROM | disk | FTP | other *** search
/ BBS Toolkit / BBS Toolkit.iso / doors_1 / multi604.zip / MONOMAIN.ZIP / MONOMAIN.PAS < prev    next >
Pascal/Delphi Source File  |  1993-01-18  |  16KB  |  483 lines
  1. program eliminateme;
  2. uses duree,
  3.      globvariables,
  4.      crt;
  5. label 2,3,4,5,6,2620;
  6. type
  7.     jeuxid=record
  8.                  vainqueur:person; {person=string[61]}
  9.                  gagnes:byte;
  10.                  perdus:byte;
  11.     end;
  12. var
  13.    jeuxfile:file of jeuxid;
  14.    jeuxrec:jeuxid;
  15.    dummy:integer;
  16.    monopath:string[20];
  17.    wu:text;
  18.    usernum:integer;
  19.    vide:string;
  20.    l0:integer;
  21.    line1:string;
  22.    h:text;
  23.    chemin,
  24.    logname:string[20];
  25.    numer,
  26.    status,
  27.    cumulelim,
  28.    tampax,
  29.    k:integer;
  30.    total:array[1..4] of integer;
  31.    var monobul:string;
  32.    var colorbul:string;
  33.  
  34. procedure sortdeed;
  35. label 58,54,56;
  36. begin
  37.      {sort deeds}
  38.      for indice8:=1 to 4 do begin
  39.          if d[indice8]<2 then goto 58;
  40.          for indice6:=1 to d[indice8]-1 do begin
  41.              for indice4:=1 to d[indice8]-1 do begin
  42.                  str(papa[indice8,indice4],nom5);
  43.                  str(papa[indice8,indice4+1],nom1);
  44.                  if (copy(nom5,2,2)='23') or (copy(nom5,2,1)='4') then begin
  45.                     val(copy(nom5,2,1),valeur,code);
  46.                     indice5:=2-valeur;
  47.                     goto 54;
  48.                  end;
  49.                  val(copy(nom5,4,2),indice5,code);
  50.                  54:;
  51.                  if (copy(nom1,2,2)='23') or (copy(nom1,2,1)='4') then begin
  52.                     val(copy(nom1,2,1),valeur,code);
  53.                     x:=2-valeur;
  54.                     goto 56;
  55.                  end;
  56.                  val(copy(nom1,4,2),x,code);
  57.                  56:;
  58.                  if indice5>x then begin
  59.                     indice9:=papa[indice8,indice4];
  60.                     papa[indice8,indice4]:=papa[indice8,indice4+1];
  61.                     papa[indice8,indice4+1]:=indice9;
  62.                  end;
  63.              end;
  64.          end;
  65.      58:;
  66.      end;
  67. end;
  68.  
  69.  
  70.  
  71. procedure readgame;
  72. begin
  73.  
  74.      readln(f,status); {1=Computer 2=Players-integer}
  75.      readln(f,oui);    {Y=need players N=Game Filled-char}
  76.      readln(f,n);      {number of players-integer}
  77.      readln(f,team);   {0=no team 1=team game-integer}
  78.      readln(f,numhe);  {# of hours a player can play is turn-integer}
  79.      readln(f,fastflag);{1=cards have been distributed-integer}
  80.      readln(f,tradeflag);{1=trade option is enable}
  81.      readln(f,expiration);{days when a game should be over 0=does not apply-integer}
  82.      readln(f,freepark); {1=free landing 0=no money in free landing}
  83.      readln(f,parkmoney); {amount in free landing-integer}
  84.      for i:=1 to n do begin
  85.          readln(f,names[i]); {players name-array[1..4] of string}
  86.          readln(f,password[i]);{password if any-array[1..4] of string[8]}
  87.          readln(f,l[i]); {position of player in the game-array[1..4] of integer}
  88.          readln(f,amount[i]); {total amount of money of player-array[1..4] of integer}
  89.          readln(f,d[i]); {# of properties owned-array[1..4] of integer}
  90.          readln(f,house[i]); {# of cities owned-array[1..4] of integer}
  91.          readln(f,hotel[i]); {# of capitals owned-array[1..4] of integer}
  92.          readln(f,jo[i]);    {array[1..4] of integer}
  93.          readln(f,lastime[i]); {array[1..4] of string}
  94.          readln(f,lastheure[i]);{array[1..4] of integer}
  95.          readln(f,eliminate[i]);{0=in the game 1=eliminated-array[1..4] of integer}
  96.          readln(f,playteam[i]); {array[1..4] of integer-1=team one 2=team two}
  97.          for x:=1 to d[i] do begin
  98.              readln(f,buffer); {string-read the properties owned}
  99.              val(buffer,papa[i,x],code);
  100.          end;
  101.          for x:=0 to 40 do begin
  102.              readln(f,price[i,x]);   {integer}
  103.              readln(f,price1[i,x]);  {integer}
  104.          end;
  105.          for x:=0 to 40 do begin
  106.              readln(f,bought[i,x]);  {char}
  107.              readln(f,sold[i,x]);    {char}
  108.          end;
  109.          for x:=1 to 10 do begin
  110.              readln(f,transatoffer[i,x]);  {integer}
  111.              readln(f,transatdemand[i,x]);  {integer}
  112.              readln(f,transatbuy[i,x]);     {integer}
  113.              readln(f,transatsell[i,x]);     {integer}
  114.          end;
  115.          readln(f,offer[i]);               {integer}
  116.          readln(f,demand[i]);               {integer}
  117.      end;
  118. end;
  119.  
  120.  
  121. procedure writegame; {rewrite the game with all the modifications}
  122. begin
  123.         writeln(f,status);
  124.         writeln(f,oui);
  125.         writeln(f,n);
  126.         writeln(f,team);
  127.         writeln(f,numhe);
  128.         writeln(f,fastflag);
  129.         writeln(f,tradeflag);
  130.         writeln(f,expiration);
  131.         writeln(f,freepark);
  132.         writeln(f,parkmoney);
  133.         for i:=1 to n do begin
  134.             writeln(f,names[i]);
  135.             writeln(f,password[i]);
  136.             writeln(f,l[i]);
  137.             writeln(f,amount[i]);
  138.             writeln(f,d[i]);
  139.             writeln(f,house[i]);
  140.             writeln(f,hotel[i]);
  141.             writeln(f,jo[i]);
  142.             writeln(f,lastime[i]);
  143.             writeln(f,lastheure[i]);
  144.             writeln(f,eliminate[i]);
  145.             writeln(f,playteam[i]);
  146.             for x:=1 to d[i] do begin
  147.                 str(papa[i,x],buffer);
  148.                 if length(buffer)<9 then begin   {that checked a problem i used to get}
  149.                    clrscr;
  150.                    writeln('Problem-Contact Pierre Tavernier');
  151.                    writeln('Author of multipolix-Leave message for him');
  152.                    writeln('At 803-366-6235...Critical Mass BBS');
  153.                    writeln(f,buffer);
  154.                    close(f);
  155.                    halt;
  156.                 end;
  157.                 writeln(f,buffer);
  158.             end;
  159.             for x:=0 to 40 do begin
  160.                 writeln(f,price[i,x]);
  161.                 writeln(f,price1[i,x]);
  162.             end;
  163.             for x:=0 to 40 do begin
  164.                 writeln(f,bought[i,x]);
  165.                 writeln(f,sold[i,x]);
  166.             end;
  167.             for x:=1 to 10 do begin
  168.                 writeln(f,transatoffer[i,x]);
  169.                 writeln(f,transatdemand[i,x]);
  170.                 writeln(f,transatbuy[i,x]);
  171.                 writeln(f,transatsell[i,x]);
  172.             end;
  173.             writeln(f,offer[i]);
  174.             writeln(f,demand[i]);
  175.         end;
  176. end;
  177.  
  178.  
  179.  
  180.  
  181. procedure loose(buffnom:string);
  182.  
  183.  
  184.  
  185. function findid(caller:person):integer;  {find the id # of the player in the score.dat file}
  186. var ind:integer;                         {if the player has never played his id will be 0}
  187.  
  188. begin
  189.      usernum:=0;
  190.      ind:=0;
  191.     { reset(jeuxfile); }
  192.      if not eof(jeuxfile) then begin
  193.         repeat
  194.               ind:=ind+1;
  195.               read(jeuxfile,jeuxrec);
  196.               if jeuxrec.vainqueur=caller then usernum:=ind;
  197.         until (usernum>0) or (eof(jeuxfile));
  198.      end;
  199.      findid:=usernum;
  200.      writeln('usernum=',usernum);
  201. end;
  202.  
  203. function nextuser:integer; {if new player, find an id for him/her}
  204. var tempete:integer;
  205. begin
  206.      tempete:=findid('***');
  207.      if tempete=0 then nextuser:=1+ filesize(jeuxfile) else nextuser:=tempete;
  208. end;
  209.  
  210. procedure rout1;  {this one is for new player}
  211. begin
  212.      usernum:=nextuser;
  213.      jeuxrec.gagnes:=0;
  214.      jeuxrec.perdus:=0;
  215.      jeuxrec.vainqueur:=buffnom;
  216.      if looseflag then jeuxrec.perdus:=1
  217.      else jeuxrec.gagnes:=1;
  218.      seek(jeuxfile,usernum-1);
  219.      write(jeuxfile,jeuxrec);
  220. end;
  221.  
  222. procedure rout2; {this one has already an id}
  223. begin
  224.      {read(jeuxfile,jeuxrec); }
  225.      if looseflag then jeuxrec.perdus:=jeuxrec.perdus+1
  226.      else jeuxrec.gagnes:=jeuxrec.gagnes+1;
  227.      seek(jeuxfile,dummy-1);
  228.      write(jeuxfile,jeuxrec);
  229. end;
  230.  
  231. begin
  232.      assign(jeuxfile,'score.dat');
  233.      {$I-}
  234.      reset(jeuxfile);
  235.      {$I+}
  236.      if ioresult=2 then rewrite(jeuxfile);
  237.      dummy:=findid(buffnom);
  238.      if dummy=0 then rout1;
  239.      if dummy>0 then rout2;
  240.      close(jeuxfile);
  241. end;
  242.  
  243. procedure elimgame; {reset all variables when the player is elimnated}
  244.  
  245. begin
  246.      newxx:=41;
  247.      l[i]:=41;
  248.      jo[i]:=1000;
  249.      amount[i]:=0;
  250.      for indice6:=1 to d[i] do begin
  251.          papa[i,indice6]:=0;
  252.      end;
  253.      d[i]:=0;
  254.      indice11:=0;
  255.      indice12:=0;
  256.      eliminate[i]:=1;
  257.      sortdeed; {sort the deeds}
  258. end;
  259.  
  260. procedure generatebulletins;   {this is the part to be improved}
  261. begin
  262.      assign(wu,monobul);
  263.      rewrite(wu);
  264.      writeln(wu,'                Multipolix Hall of Fame          ');
  265.      writeln(wu,'                -----------------------          ');
  266.      writeln(wu,' ');
  267.      writeln(wu,'Player"s Name           Games Won      Games Lost');
  268.      assign(jeuxfile,'score.dat');
  269.      reset(jeuxfile);
  270.      if not eof(jeuxfile) then begin
  271.         repeat
  272.               vide:='';
  273.               read(jeuxfile,jeuxrec);
  274.               l0:=length(jeuxrec.vainqueur);
  275.               for i:=1 to 30-l0 do vide:=vide + ' ';
  276.                   writeln(wu,jeuxrec.vainqueur,vide,jeuxrec.gagnes,
  277.                   '              ',jeuxrec.perdus);
  278.         until eof(jeuxfile);
  279.         end;
  280.         close(jeuxfile);
  281.         close(wu);
  282.         assign(wu,colorbul);
  283.         rewrite(wu);
  284.         line1:=concat(#27,'[31m','                Multipolix Hall of Fame          ');
  285.         writeln(wu,line1);
  286.         writeln(wu,'                -----------------------          ');
  287.         writeln(wu,' ');
  288.         line1:=concat(#27,'[32m','Player"s Name');
  289.         line1:=concat(line1,#27,'[33m','           Games Won      Games Lost');
  290.         writeln(wu,line1);
  291.         reset(jeuxfile);
  292.         if not eof(jeuxfile) then begin
  293.            repeat
  294.                  vide:='';
  295.                  read(jeuxfile,jeuxrec);
  296.                  l0:=length(jeuxrec.vainqueur);
  297.                  for i:=1 to 30-l0 do vide:=vide + ' ';
  298.                  writeln(wu,jeuxrec.vainqueur,vide,jeuxrec.gagnes,
  299.                  '              ',jeuxrec.perdus);
  300.            until eof(jeuxfile);
  301.         end;
  302.         close(wu);
  303.         close(jeuxfile);
  304. end;
  305.  
  306.  
  307. begin                              {main loop}
  308.      assign(h,'monomain.ctl');     {this file is edited by the sysop}
  309.      {$I-}
  310.      reset(h);
  311.      {$I+}
  312.      if ioresult =2 then begin
  313.         writeln('Monomain.ctl is missing');
  314.         halt;
  315.      end;
  316.      readln(h,numer); {# of days a game should be erased if not played}
  317.      readln(h,monobul); {name of monochrome bulletin}
  318.      readln(h,colorbul); {name of ansi bulletin}
  319.      {writeln('monobul=',monobul);
  320.      writeln('colorbul=',colorbul); this was just done for debugging}
  321.      close(h);
  322.      for k:=1 to 99 do begin  {computer game loop to see if the player}
  323.          str(k,sub);          {has not played during numer days}
  324.          monopath:='mono'+sub;
  325.          assign(f,monopath);
  326.          {$I-}
  327.          reset(f);
  328.          {$I+}
  329.          if ioresult=2 then goto 2;
  330.          readln(f,status);
  331.          if status<>1 then begin {status=1 for computer game}
  332.             close(f);
  333.             goto 2;
  334.          end;
  335.          readln(f,buffnom);  {string-name of the player}
  336.          readln(f,laston);   {string-date the game was last played}
  337.          close(f);
  338.          if daynum(date)-daynum(laston)>numer then begin
  339.             {close(f); }      {eradicate the game if it has not been played}
  340.             erase(f);
  341.          end;
  342.          2:;
  343.      end;
  344.      for k:=1 to 99 do begin {players game loop to check if a player has not}
  345.          str(k,sub);         {played in numer days}
  346.          monopath:='mono'+sub;
  347.          assign(f,monopath);
  348.          {$I-}
  349.          reset(f);
  350.          {$I+}
  351.          if ioresult=2 then goto 3;
  352.          readln(f,status);
  353.          if status<>2 then begin
  354.             close(f);
  355.             goto 3;
  356.          end;
  357.          close(f);
  358.          reset(f);
  359.          readgame;
  360.          close(f);
  361.          if oui='Y' then goto 3; {game still needs players-do not process}
  362.          for i:=1 to n do begin
  363.             if (daynum(date)-daynum(lastime[i]) > numer)
  364.             and (eliminate[i]=0) then begin
  365.                 elimgame;   {reset his/her variables}
  366.             end;
  367.         end;
  368.         rewrite(f);
  369.         writegame;  {write the new modifications}
  370.         close(f);
  371.      3:;
  372.      end;
  373.  
  374.  
  375.    {check to see if a game is finished-That means only one player is playing}
  376.     for k:=1 to 99 do begin
  377.          str(k,sub);
  378.          monopath:='mono'+sub;
  379.          assign(f,monopath);
  380.          {$I-}
  381.          reset(f);
  382.          {$I+}
  383.          if ioresult=2 then goto 4;
  384.          for i:=1 to 4 do names[i]:='';
  385.          readln(f,status);
  386.          if status<>2 then begin {take only player games}
  387.             close(f);
  388.             goto 4;
  389.          end;
  390.          close(f);
  391.          reset(f);
  392.          readgame;
  393.          close(f);
  394.          if oui='Y' then goto 4; {still needs players-Do not process}
  395.          cumulelim:=0;
  396.          for i:=1 to n do
  397.              if eliminate[i]=0 then cumulelim:=cumulelim+1;
  398.          if cumulelim=0 then  begin {means that everybody is eliminated}
  399.             erase(f);
  400.             str(k,sub);
  401.             logname:='log'+sub;
  402.             assign(u,logname);
  403.             {$I-}
  404.             erase(u);  {erase the log}
  405.             {$I+}
  406.          end
  407.          else if cumulelim=1 then begin  {only one player left}
  408.               for i:=1 to n do begin     {let's find him}
  409.                   if eliminate[i]=0 then looseflag:=true else looseflag:=false;
  410.                   buffnom:=names[i];
  411.                   loose(buffnom);
  412.               end;
  413.               generatebulletins;
  414.               logname:='log'+sub;
  415.               assign(u,logname);
  416.               {$I-}
  417.               erase(u);  {erase the log}
  418.               {$I+}
  419.          end;
  420.     4:;
  421.     end;
  422.  
  423.     for k:=1 to 99 do begin {check if the game has an epiration date}
  424.          str(k,sub);
  425.          monopath:='mono'+sub;
  426.          assign(f,monopath);
  427.          {$I-}
  428.          reset(f);
  429.          {$I+}
  430.          if ioresult=2 then goto 5;
  431.          for i:=1 to 4 do names[i]:='';
  432.          readln(f,status);
  433.          if status<>2 then begin
  434.             close(f);
  435.             goto 5;
  436.          end;
  437.          close(f);
  438.          reset(f);
  439.          readgame;
  440.          close(f);
  441.          if oui='Y' then goto 5;
  442.          for i:=1 to 4 do total[i]:=0;
  443.          if (expiration<>0) and (expiration < daynum(date))  then begin
  444.             for i:=1 to n do begin    {compute the total amount of $$$}
  445.                 total[i]:=amount[i];  {for each player}
  446.                 if d[i]=0 then goto 6;
  447.                 for k:=0 to d[i] do begin
  448.                     str(papa[i,k],nom1);
  449.                     val(copy(nom1,6,2),valeur,code);
  450.                     total[i]:=total[i]+20*fininfo[8*valeur];
  451.                     val(copy(nom1,8,1),indice2,code);
  452.                     if copy(nom5,2,1)='4' then goto 6;
  453.                     if copy(nom5,2,2)='23' then goto 6;
  454.                     if indice2>2 then goto 2620;
  455.                     val(copy(nom1,6,2),valeur,code);
  456.                     total[i]:=total[i]+fininfo[8*valeur+indice2-8];
  457.                     2620:;
  458.                     val(copy(nom1,6,2),valeur,code);
  459.                     total[i]:=total[i]+10*fininfo[8*valeur+indice2-8];
  460.                 end;
  461.                 6:;
  462.             end;
  463.             tampax:=total[1];
  464.             for i:=2 to n do 
  465.                 if total[i] > tampax then tampax:=total[i];
  466.             for i:=1 to n do
  467.                 if total[i]=tampax then eliminate[i]:=0 else eliminate[i]:=1;
  468.             erase(f);
  469.             logname:='log'+sub;
  470.             assign(u,logname);
  471.             {$I-}
  472.             erase(u);  {erase log}
  473.             {$I+}
  474.             for i:=1 to n do begin
  475.              if eliminate[i]=0 then looseflag:=true else looseflag:=false;
  476.              buffnom:=names[i];
  477.              loose(buffnom);
  478.             end;
  479.             generatebulletins;
  480.          end;
  481.          5:;
  482.     end;
  483. end.